home *** CD-ROM | disk | FTP | other *** search
/ Aminet 33 / Aminet 33 - October 1999.iso / Aminet / misc / math / TCalcStats2c.lha / TCalcStats2c / AREXX / Histogram.rexx < prev    next >
Encoding:
OS/2 REXX Batch file  |  1998-08-02  |  7.7 KB  |  374 lines
  1. /* Histogram */
  2.  
  3. options results
  4. if ~show('P','TCALC') then do
  5.     address command 'run turbocalc:turbocalc'
  6.     address command 'waitforport TCALC'
  7.     loadflag=1
  8. end
  9. address 'TCALC'
  10. 'DEFPUBSCREEN()'
  11. /* Add-in Rexx Math Library needed for some routines */
  12. signal on syntax
  13. if ~show('l','rexxmathlib.library') then
  14.    call addlib('rexxmathlib.library',0,-30)
  15. if ~show('l','rexxreqtools.library') then
  16.    call addlib('rexxreqtools.library',0,-30)
  17. if ~show('l','rexxsupport.library') then
  18.    call addlib('rexxsupport.library',0,-30)
  19.   /* add to library list */
  20. signal off syntax
  21.  
  22. /* Start Main Routine */
  23. if loadflag=1 then 'Load()'
  24. 'ActivateWindow()'
  25. range=rtgetstring(,"Enter Cell Range for Input","Input Request") /*,,'rt_pubscrname="TCALC"')*/
  26. colon=pos(":",range)
  27. if colon=0 then do
  28.     'Message "Please select a range before executing this script"'
  29.     'DEFPUBSCREEN("Workbench")'
  30.     exit
  31. end
  32.  
  33. /* Find cell references and cell, column numbers */
  34. start_cell=substr(range,1,colon-1)
  35. end_cell=substr(range,colon+1)
  36. start_row=cellrow(start_cell)
  37. end_row=cellrow(end_cell)
  38. start_col=cellcol(start_cell)
  39. end_col=cellcol(end_cell)
  40. NRows=end_row-start_row+1
  41. NCols=end_col-start_col+1
  42.  
  43. /* Get cell reference for output range */
  44. out_cell=rtgetstring(,"Enter Cell Reference for Output","Input Request") /*,,'rt_pubscrname="TCALC"')*/
  45. if out_cell="" then do
  46.     'DEFPUBSCREEN("Workbench")'
  47.     exit
  48. end
  49. if length(out_cell)<2 | datatype(left(out_cell,1),'n')=1 then do
  50.     'Message "Invalid cell reference"'
  51.     'DEFPUBSCREEN("Workbench")'
  52.     exit
  53. end
  54. /* Suppress Screen Redraw to Speed Things Up */
  55. 'Refresh 0'
  56.  
  57. /* Open a small output window on tcalc screen*/
  58. fo=0
  59. CR='0a'x
  60. DisplayMsg="Calculating...Please Wait."||CR||"User input is disabled during calculation."||CR
  61. if open(6Info, 'con:100/0/450/80/Progress/SCREEN TCALC', w) then do
  62.      call writeln(6Info, DisplayMsg)
  63.     fo=1
  64. end
  65. else do
  66.     'Message "TCALC Screen not available for Progress messages"'
  67. end
  68. CALL DELAY(150)
  69.  
  70. /* Get cell references for top cell in each column */
  71. 'SelectCell' start_cell
  72. do col=start_col to end_col
  73.     'GetCursorPos'
  74.     top_cell.col=result
  75.     'Column 1'
  76. end
  77.  
  78. /* Get labels for later use on output */
  79. 'SelectCell' start_cell
  80. 'GetValue'
  81. testlabel=result
  82. testlabel=strip(testlabel)
  83. if datatype(testlabel,'n')=1 then do
  84.     labelflag=0
  85.     title="Column "||x
  86. end
  87. else do
  88.     labelflag=1
  89.     NRows=NRows-1
  90.     title=testlabel
  91. end
  92. if fo then call writech(6Info,"Progress...10 ")
  93.  
  94. /* Get data from cell range */
  95. col=start_col
  96. lav=0
  97. tot=0
  98. count=0
  99. total=0
  100. do x=1 to NCols
  101.     'SelectCell' top_cell.col
  102.     if labelflag=1 then 'CursorDown 1'
  103.     do y=1 to NRows
  104.         'GetValue'
  105.         valtest=result
  106.         if datatype(valtest)='NUM' then do
  107.             'GetValue'
  108.             val=result
  109.             val=strip(val)
  110.             data.y=val
  111.             total=total+val
  112.             count=1+count
  113.         end
  114.         'CursorDown 1'
  115.     end
  116. if fo then call writech(6Info,"20 ")
  117.  
  118. /* Sort Values */
  119. call Sort()
  120. if fo then call writech(6Info,"40 ")
  121.  
  122. /* Calculate Minimum, Maximum */
  123. min=0
  124. max=0
  125. N=count
  126. min=data.1
  127. max=data.N
  128. if fo then call writech(6Info,"60 ")
  129.  
  130. /* Get Bin Range from User */
  131. cr='0a'x
  132. test=1
  133. x=1
  134. Nbins=0
  135. BW=0
  136. bin.=0
  137. str="Enter first cell reference for Bin range"||cr||"(or press CANCEL for auto Bin calculation)"
  138. binstart=rtgetstring(,str,"Input Request",,'rt_pubscrname="TCalc"')
  139. auto=rtresult
  140. if auto=0 then do
  141.     Nbins=trunc(sqrt(count))
  142.     if Nbins<5 then Nbins=5
  143.     if Nbins>15 then Nbins=15
  144.     bin.1=min
  145.     BW=(max-min)/Nbins
  146.     do x=2 to Nbins
  147.         z=x-1
  148.         bin.x=(bin.z)+BW
  149.     end
  150. end
  151. else do
  152.     'SelectCell' binstart
  153.     'GetValue'
  154.     valtest=result
  155.     if datatype(valtest)='CHAR' then 'CursorDown 1'
  156.     bread=0
  157.     do while bread=0
  158.         'GetValue'
  159.         test=result
  160.         test=strip(test)
  161.         if datatype(test,'n')~=1 then leave
  162.         Nbins=Nbins+1
  163.         bin.x=test
  164.         x=x+1
  165.         'CursorDown 1'
  166.     end
  167. end
  168. if fo then call writech(6Info,"80 ")
  169.  
  170. x=1
  171. freq.=0
  172. do y=1 to NRows
  173.     z=x+1
  174.     if x<Nbins then 
  175.     if (data.y)>=(bin.x) & (data.y)<(bin.z) then freq.x=(freq.x)+1
  176.     else do
  177.         y=y-1
  178.         x=x+1
  179.     end
  180.     else freq.x=(freq.x)+1
  181. end
  182. Cumfreq.=0
  183. Cumpc.=0
  184. Cumfreq.1=freq.1
  185. Cumpc.1=((freq.1)/count)*100
  186. do x=2 to Nbins
  187.     z=x-1
  188.     Cumfreq.x=freq.x+Cumfreq.z
  189.     Cumpc.x=((Cumfreq.x)/count)*100
  190. end
  191. if fo then do
  192.     call writeln(6Info,"100 ")
  193.     call writeln(6Info,"Writing output to window...")
  194. end
  195. /* Output */
  196. 'SelectCell' out_cell
  197. 'ColumnWidth 10'
  198. 'Put' "Histogram"
  199. 'CursorDown 2'
  200. title=""""||title||""""
  201. 'Put' title
  202. 'CursorDown 2'
  203. 'GetCursorPos'
  204. st_cell=result
  205. 'Alignment 2'
  206. 'Put' "Bin"
  207. 'Column 1'
  208. 'Alignment 2'
  209. 'Put' "Frequency"
  210. 'Column 1'
  211. 'Alignment 2'
  212. 'Put "Cum. Freq."'
  213. 'Column 1'
  214. 'Alignment 2'
  215. 'Put "Cum. %"'
  216. 'SelectCell' st_cell
  217. 'CursorDown 1'
  218. do x=1 to Nbins
  219.     'Put' bin.x
  220.     'CursorDown 1'
  221. end
  222. 'SelectCell' st_cell
  223. 'Column 1'
  224. 'CursorDown 1'
  225. do x=1 to Nbins
  226.     'Put' freq.x
  227.     'CursorDown 1'
  228. end
  229. 'SelectCell' st_cell
  230. 'Column 2'
  231. 'CursorDown 1'
  232. do x=1 to Nbins
  233.     'Put' Cumfreq.x
  234.     'CursorDown 1'
  235. end
  236. 'SelectCell' st_cell
  237. 'Column 3'
  238. 'CursorDown 1'
  239. do x=1 to Nbins
  240.     'Put' format(Cumpc.x,,2)
  241.     'CursorDown 1'
  242. end
  243. 'Refresh 1'
  244. 'Refresh 2'
  245. /*'Message' "Finished"*/
  246. /*indicate the main script is finished*/
  247. DisplayMsg="Cleaning up ...."||CR||"Exiting"
  248. result=writeln(6Info, DisplayMsg)
  249. if result~=0 then do
  250.     /*Wait 3 seconds*/
  251.     CALL DELAY(150)
  252.     /* close window*/
  253.     result=close(6Info)
  254. end
  255. 'DEFPUBSCREEN("Workbench")'
  256. exit
  257.  
  258. /* Procedures */
  259.  
  260. cellrow: procedure
  261. do
  262.     parse arg cell
  263.     do charpos=2 to length(cell)
  264.     if datatype(substr(cell,charpos,1),n) then return substr(cell,charpos)
  265.     end
  266.     return 0
  267. end
  268. Return
  269.  
  270. cellcol: procedure
  271. do
  272.     parse arg cell
  273.     labels="ABCDEFGHIJKLMNOPQRSTUVWXYZ"
  274.     cell=upper(cell)
  275.     len=length(cell)
  276.     val=0
  277. do charpos=1 to len
  278.     if datatype(substr(cell,charpos,1),n) then
  279.     do cell=reverse(substr(cell,1,charpos-1))
  280.     do x=1 to length(cell)
  281.     val=(26**(x-1))*pos(substr(cell,x,1),labels)+val
  282.     end
  283.     return val
  284.     end
  285.     end
  286.     return 0
  287. end
  288. Return
  289. /* It is important to put the exposed array at the end of the next line */
  290. Sort: procedure expose  NRows data.
  291. L=(xtoy(2,int(log(NRows)/log(2))))-1
  292.     Do Until L<1
  293.     L=trunc(int(L/2))
  294.     Do J=1 to L
  295.             Do K=J+L To NRows By L
  296.             I=K
  297.             dumdat=data.I
  298.             Do while I>L
  299.                 y=I-L
  300.                 If data.y ~> dumdat then Leave
  301.                 data.I=data.y
  302.                 I=I-L
  303.             End
  304.             data.I=dumdat
  305.             End
  306.         End
  307.     End
  308. Return
  309.  
  310. syntax:
  311.      if arg(1)='FAIL' then do
  312.         'Message "Library is unavailable."'
  313.         'DEFPUBSCREEN("Workbench")'
  314.         exit
  315.         end
  316.     'DEFPUBSCREEN("Workbench")'
  317.     exit
  318.  
  319. Format:  procedure
  320.  
  321.      arg number, before, after
  322.      CallLine = SIGL
  323.      if ~datatype(CallLine, 'N') then CallLine = '??'
  324.  
  325.      /* Make sure we have a number as first (required) argument    */
  326.      if ~datatype(number, 'N') then do
  327.         if number = '' then
  328.            fc = 17     /* Wrong number of arguments           */
  329.         else
  330.            fc = 47     /* Arithmetic conversion error             */
  331.         signal FormatSyntaxError
  332.      end
  333.      num = number + 0
  334.      if before = '' & after = '' then
  335.         return num
  336.      else do
  337.         parse var num integer '.' fraction
  338.         if before = '' then before = length(integer)
  339.         if after = '' then after = length(fraction)
  340.         if ~datatype(before, N) | ~datatype(after, N) then
  341.            do fc = 18
  342.            signal FormatSyntaxError
  343.        end
  344.         if before < length(integer) then do
  345.            fc = 18
  346.            signal FormatSyntaxError
  347.         end
  348.         if after ~= length(fraction) then do
  349.            fraction = trunc(('.'fraction'0') + ('.'copies('0', after)'5'), after)
  350.         if integer<1&integer>-1 then integer=integer
  351.            else integer = integer + (fraction % 1)
  352.            fraction = substr(fraction, 3)
  353.         end
  354.         if fraction >= 0 then
  355.            return right(integer, before)'.'fraction
  356.         else
  357.            return right(integer, before)
  358.      end
  359.  
  360.  FormatSyntaxError:
  361.         if show('F', STDERR) then
  362.            call writeln(STDERR, '+++ Error' fc 'in line' CallLine':' errortext(fc))
  363.         else
  364.            mess='+++ Error' fc 'in line' CallLine':' errortext(fc)
  365.         'Message' mess
  366.         parse source Func .
  367.         if Func = 'FUNCTION' then do
  368.         'DEFPUBSCREEN("Workbench")'
  369.            exit "Err"
  370.         end
  371.         else do
  372.         'DEFPUBSCREEN("Workbench")'
  373.            exit 10
  374.         end